#Appendix: R code Nov 9 2021
#In this appendix, we attach the R programming code for MAUTPPE in the Poisson regression model data for analyzing Swedish traffic fatality data set.
#The results of this code are shown in Table 5.1.

rm(list=ls())
data <- read.csv(file.choose())					#Attach data file
attach(data)
n <- 21  							#Sample size for Swedish traffic fatality data
X <- cbind(V2,V3,V4,V5,V6,V7)
X <- scale(X,center = TRUE,scale = TRUE)
p <- ncol(X)
P <- p+1
model <- glm(V1 ~ X,family = poisson(link="log"))		#Poisson regression model
W <- diag(model$weight)
X1 <- cbind(1,X)
S <- t(X1)%*%W%*%X1
lambda <- eigen(S)$values	  				#Eigenvalues
sqrt((max(lambda))/(min(lambda))) 				#Condition Index
mle <- matrix(model$coefficients) 				#Estimated MLE
alpha <- (eigen(S)$vectors)%*%mle
I <- matrix(diag(P),P,P)
l2=lambda	#Square of Eigenvalues
a2=alpha^2
							#Square of alpha
## Algorithm to estimate parameters k and d.
#Step1

d  <- runif(1)
kj <- abs((l2+(2-a2*(1+d)^2)*lambda-d^2+2*d)/(a2*(lambda+1)^2)) 
k1 <- min(sqrt(1/kj))
k2 <- max(kj)
k3 <- mean(kj)
k4 <- median(kj)
#Step2

d1 <- min((a2*l2+1)/(sqrt(k1*lambda)*(a2*lambda+a2)*sqrt(a2*l2+1)+a2*l2+1)) 
d2 <- min((a2*l2+1)/(sqrt(k2*lambda)*(a2*lambda+a2)*sqrt(a2*l2+1)+a2*l2+1))
d3 <- min((a2*l2+1)/(sqrt(k3*lambda)*(a2*lambda+a2)*sqrt(a2*l2+1)+a2*l2+1))
d4 <- min((a2*l2+1)/(sqrt(k4*lambda)*(a2*lambda+a2)*sqrt(a2*l2+1)+a2*l2+1))
#Step3

kj <- abs((l2+(2-a2*(1+d1)^2)*lambda-d1^2+2*d1)/(a2*(lambda+1)^2)) 
k1 <- min(sqrt(1/kj))
kj <- abs((l2+(2-a2*(1+d2)^2)*lambda-d2^2+2*d2)/(a2*(lambda+1)^2))
k2 <- max(kj)
kj <- abs((l2+(2-a2*(1+d3)^2)*lambda-d3^2+2*d3)/(a2*(lambda+1)^2))
k3 <- mean(kj)
kj <- abs((l2+(2-a2*(1+d4)^2)*lambda-d4^2+2*d4)/(a2*(lambda+1)^2))
k4 <- median(kj)
#Step4

d1 <- min((a2*l2+1)/(sqrt(k1*lambda)*(a2*lambda+a2)*sqrt(a2*l2+1)+a2*l2+1)) 
d2 <- min((a2*l2+1)/(sqrt(k2*lambda)*(a2*lambda+a2)*sqrt(a2*l2+1)+a2*l2+1))
d3 <- min((a2*l2+1)/(sqrt(k3*lambda)*(a2*lambda+a2)*sqrt(a2*l2+1)+a2*l2+1))
d4 <- min((a2*l2+1)/(sqrt(k4*lambda)*(a2*lambda+a2)*sqrt(a2*l2+1)+a2*l2+1))

### TPPE ###
k <- max(lambda/(lambda*(1-d)*a2-d))
TPPE <- (solve(S+k*I))%*%(S+k*d*I)%*%mle
#Proposed Estimator
### MAUTPPE ###

fkd1 <- (I-((1-d1)^2*(solve(S+I)%*%solve(S+I))))%*%solve(I+k1*solve(S))
fkd2 <- (I-((1-d2)^2*(solve(S+I)%*%solve(S+I))))%*%solve(I+k2*solve(S))
fkd3 <- (I-((1-d3)^2*(solve(S+I)%*%solve(S+I))))%*%solve(I+k3*solve(S))
fkd4 <- (I-((1-d4)^2*(solve(S+I)%*%solve(S+I))))%*%solve(I+k4*solve(S))
MAUTPPE1 <- fkd1%*%mle
MAUTPPE2 <- fkd2%*%mle
MAUTPPE3 <- fkd3%*%mle
MAUTPPE4 <- fkd4%*%mle
								# Scalar Mean Square Error
### MSE ###
MSEMLE=(sum(1/lambda))						#SMSE(MLE)
								#SMSE(TPPE)
MSETPPE=sum(((lambda+k*d)^2)/((lambda+k)^2*lambda))+sum((k^2*(d-1)^2*a2)/((lambda+k)^2)) 
 
c1 <- lambda*((lambda+1)^2-(1-d1)^2)^2
c2 <- a2*(k1*(lambda+1)^2+lambda*(1-d1)^2)^2
MSEMAUTPPE1 <- sum((c1 + c2)/((lambda+k1)^2*(lambda+1)^4))	#SMSE(MAUTPPE(d, k1))

c1 <- lambda*((lambda+1)^2-(1-d2)^2)^2
c2 <- a2*(k2*(lambda+1)^2+lambda*(1-d2)^2)^2
MSEMAUTPPE2 <- sum((c1 + c2)/((lambda+k2)^2*(lambda+1)^4))	#SMSE(MAUTPPE(d, k2))

c1 <- lambda*((lambda+1)^2-(1-d3)^2)^2
c2 <- a2*(k3*(lambda+1)^2+lambda*(1-d3)^2)^2
MSEMAUTPPE3 <- sum((c1 + c2)/((lambda+k3)^2*(lambda+1)^4))	#SMSE(MAUTPPE(d, k3))

c1 <- lambda*((lambda+1)^2-(1-d4)^2)^2
c2 <- a2*(k4*(lambda+1)^2+lambda*(1-d4)^2)^2
MSEMAUTPPE4 <- sum((c1 + c2)/((lambda+k4)^2*(lambda+1)^4))	#SMSE(MAUTPPE(d, k4))

#Estimated SMSE of estimators
MSE <- cbind(MSEMLE,MSETPPE,MSEMAUTPPE1,MSEMAUTPPE2,MSEMAUTPPE3,MSEMAUTPPE4)	

#Estimated coefficients of estimators
coeff <- cbind(mle,TPPE,MAUTPPE1,MAUTPPE2,MAUTPPE3,MAUTPPE4 
